{-# OPTIONS_GHC -fglasgow-exts #-}
module Hixay.UI.GenerateScript where

import WS.Runtime.XML
import WS.Runtime.Main
import XI.Directory.GetXiObj
import XI.Directory.Todo
import XI.Directory.Parser
import XI.Directory.Types
import Graphics.UI.WX
import Graphics.UI.WXCore.WxcClassesMZ
import Codec.Binary.Base64.String
import Control.Concurrent
import Data.Maybe
import Control.Monad
import Control.Arrow
import qualified Data.Map as Map
-- import Data.Time.Clock
import Hixay.UI.Editor
import Hixay.UI.Tools
import System.IO.UTF8 (readFile, writeFile)
import Prelude hiding (readFile, writeFile)

generateScript :: forall a. Var [String] -> Window a -> IO (Window a)
generateScript wspVar p = do
    pTop <- panel p [bgcolor := colorSystem ColorInfoBk]
    pClient <- panel p []
    tes <- mapM (mkTe pClient) ["Result.res", "Result.xml", "Merged.xml"]
    tePrev <- mkTe pTop "Previous.xml"
    set tePrev [bgcolor := colorSystem ColorInfoBk]
    pEdit <- panel pClient [] 
    b <- button pTop [
            text := "Generate", 
            on command := -- do
                    -- time0 <- getCurrentTime 
                    windowDestroyChildren pEdit >> varGet wspVar >>= getWsParam >>= getConfiguration >>= 
                        (\err -> set (head tes) [text := "Error: " ++ err]) ||| 
                        (\cfg@(scs, _) -> do
                                new_scs <- liftM (flip mergeScenarios scs . (fromXml "root" "Scenario" :: String -> [Scenario])) 
                                                 (get tePrev text >>= flip catch (return . const "") . readFile)
                                        
                                zipWithM_ (\te s -> get te text >>= \file -> writeFile file s)
                                        tes [scriptDir' cfg, toXml' scs, toXml' new_scs]
                                panel pEdit [] >>= flip editor new_scs >>= windowSetLayout pEdit . fill . widget >> get pEdit parent >>= refresh_
                            )
                    -- time1 <- getCurrentTime
                    -- infoDialog p "< Hixay Inform >" ("Generation completed by " ++ (show $ diffUTCTime time1 time0) ++ "..." )
                        
        ]
    windowSetLayout p $ column 10 [
            boxed "" $ margin 2 $ container pTop $ margin 10 $ row 40 [widget b, row 10 $ mkRow "Previous xml-file to merge" tePrev],
            container pClient $ column 10 [
                    boxed "Files to generate" $ margin 5 $ grid 20 5 $ 
                            zipWith mkRow ["Result script-file", "Result xml-file", "New merged xml-file"] tes,
                    boxed "Generated data" $ margin 5 $ fill $ widget pEdit
                ]
        ]
    return p
    where
        mkTe pan txt = textEntry pan [alignment := AlignLeft, text := txt]
        scriptDir' = unlines . scriptDir 
        toXml' = toXml True "root" "Scenario"
                            
mergeScenarios :: [Scenario] -> [Scenario] -> [Scenario]
-- take new and change additionals for senders and receivers
mergeScenarios old new = map merge new
    where
        sp = s_sys &&& s_int
        spcs = sp . chain_sender
        merge sc = sc {scenario_chains = map merge_ch $ scenario_chains sc}
            where
                merge_ch x = x {
                        chain_sender = merge_s $ chain_sender x, 
                        chain_receivers = map merge_r $ chain_receivers x
                    }
                    where
                        merge_s y = y { s_params = join . Map.lookup (sp y) $ fst pmp }
                        merge_r r = r { r_ints = map merge_ri $ r_ints r }
                            where
                                merge_ri z = z { r_params = (join . Map.lookup ((spcs x, r_sys r), r_int z) $ snd pmp) }
        
        pmp = (Map.fromList $ liftM ((sp &&& s_params) . chain_sender) (old >>= scenario_chains),
                Map.fromList $ old >>= scenario_chains >>= \ch -> chain_receivers ch >>= 
                        \r -> liftM (first ((,) (spcs ch, r_sys r)) . (r_int &&& r_params)) (r_ints r)) 

getConfiguration :: WsParams -> IO (Either String Configuration)
getConfiguration ws_param = do
    res <- liftM concat
                (mapM setVar [getCC, getSA, getRA, getRD, getID, getCS, getIP] >>= mapM takeMVar) 
    saveProxy ws_param >> return (scenarios res)
    where
        setVar f = newEmptyMVar >>= 
                    \res -> forkIO (f ws_param >>= 
                    putMVar res) >> return res
        
getWsParam :: [String] -> IO WsParams
getWsParam wsp = liftM2 (\pr lv -> WsParams {
            wspProxyMVar = pr,
            wspLogMVar = lv,
            wspServer = head wsp,
            wspAuthorization = Just $ "Basic " ++ encode (wsp!!1),
            wspProxy = prxFile,
            wspProtocolStr = "HTTPBasicAuth?style=document",
            wspLog = logFile
        }) (wsProxy prxFile >>= newMVar) (newMVar ())
    where
        logFile = getMB 3
        prxFile = getMB 2
        getMB n = listToMaybe . words . (!!n) $ wsp
